-- cabinsheet.ml - Generate (crappy) HTML cabin sheets from CSV
-- Copyright (C) 2012  Jack Kelly
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

import Control.Monad
import Data.Char
import qualified Data.Map as Map
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import Text.CSV
import Text.Html
import Text.ParserCombinators.Parsec.Error
import Text.Printf

-- Cabinsheets are a lot simpler than bunkplans: it's just a series of
-- records of the form (Cabin, Bunk, Watch, Name). Watch names get
-- colorized, and the string "HOT BUNK" is rendered in purple.
data CabinEntry = CabinEntry {
      bunk :: String,
      watch :: String,
      name :: String
}

type CabinPlan = Map.Map String [CabinEntry]

-- Trim a CSV file: remove empty columns on the left, empty rows at
-- top or bottom and empty cells at the end of the row.
trimCSV :: CSV -> CSV
trimCSV = noEmpty . trimRight . trimLeft where
    noEmpty = filter (/= [])
    trimRight = map $ reverse . (dropWhile (== "")) . reverse
    trimLeft csv = let margin = minimum
                                $ map length
                                $ map (takeWhile (== "")) csv in
                   map (drop margin) csv

-- Non-structural fixups on the CSV.
tidy :: CSV -> CSV
tidy = upper . trimCells where
    upper = map $ map $ map toUpper
    trimCells = map $ map $ (reverse . (dropWhile isSpace) . reverse)

-- Read the cabin plan into something useful.
parseCabinPlan :: CSV -> CabinPlan
parseCabinPlan = foldr addEntry Map.empty where
    addEntry [cabin, bunk, watch, name] =
        Map.insertWith (++) cabin [CabinEntry {
                                     bunk = bunk,
                                     watch = watch,
                                     Main.name = name
                                   }]
    addEntry _ = error "Malformed line in CSV"

readCabinPlan :: FilePath -> IO CabinPlan
readCabinPlan file = do
  csv <- parseCSVFromFile file
  case csv of
    Left err -> error $ concatMap messageString $ errorMessages err
    Right records -> return $ parseCabinPlan $ tidy $ trimCSV records

-- Generate cabin sheet.
colorize :: String -> Html
colorize "RED" = (font << "RED") ! [color "red"]
colorize "BLUE" = (font << "BLUE") ! [color "blue"]
colorize "GREEN" = (font << "GREEN") ! [color "green"]
colorize "HOT BUNK" = (font << "HOT BUNK") ! [color "purple"]
colorize other = toHtml other

makeCabinSheet :: String -> [CabinEntry] -> String
makeCabinSheet cabin entries =
    doctype ++ (prettyHtml $ thehtml << (theHead +++ theBody)) where
        doctype = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n"
        size = length entries
        smallCabin = size <= 5
        bigNames = any ((>= 15) . length . Main.name) entries
        fontSize
            | smallCabin = "6"
            | bigNames   = "5"
            | otherwise  = "4"

        title = (printf "BUNK PLAN %s" cabin) :: String
        theHead = header << thetitle << title
        theH1 = (h1 << title) ! [align "center"]

        spacer = if smallCabin then iterate (br +++) br !! 3 else noHtml

        headingCell label = th
                            << center
                            << (font << underline << label) ! [color navy]
        headingRow = foldl1 (+++) $ map headingCell ["BUNK", "WATCH", "NAME"]
        cell label = td << center << label
        row entry = tr << ((cell $ bunk entry)
                           +++ (cell $ colorize $ watch entry)
                           +++ (cell $ Main.name entry))
        theRows = map row entries
        theTable = (table << (headingRow +++ theRows)) ! [cellpadding 5,
                                                          cellspacing 40]
        content = center << ((font << bold << theTable)
                             ! [Text.Html.size fontSize])
        theBody = body << (theH1 +++ content)

-- Turn the input filename into an output filename.
makeFileName :: FilePath -> String -> FilePath
makeFileName template name = (dropExtension template) ++ "-" ++ name ++ ".html"

printCabinSheet :: FilePath -> String -> [CabinEntry] -> IO ()
printCabinSheet template cabin entries =
    writeFile (makeFileName template cabin) (makeCabinSheet cabin entries)

printCabinSheets :: FilePath -> CabinPlan -> IO ()
printCabinSheets template cabins =
    mapM_ (uncurry $ printCabinSheet template) $ Map.toList cabins

main :: IO ()
main = do
  args <- getArgs
  case args of
    [file] -> do
              plan <- readCabinPlan file
              printCabinSheets file plan
              exitSuccess
    _ -> do
         putStrLn "Must have a single filename argument."
         exitFailure
